Ladder of Transformations

year={1940,1945,1950,1955,1960,1965,1970,1975,1980,1985,1990};
timeperiod=(year-1940)/5;
bluefish={1.5,15,25,27.5,27,28,29,65,120,150,275};
bluecrabs={10,85,133,250,300,370,440,466,480,442,500};
bluefishdata=Transpose[{timeperiod,bluefish}];
bluecrabsdata=Transpose[{timeperiod,bluecrabs}];

bluefishplot=ListPlot[bluefishdata]

transbluefishdata=Transpose[{timeperiod,Log[bluefish]}];
transbluefishplot=ListPlot[transbluefishdata]

Fit[transbluefishdata,{1,x},x]

ln y = 1.66808  + 0.379678 x
y = (e^1.66808) (e^(0.379678 x)) 
y = 5.3 (e^(0.3797x))  or y = 5.3 ((1.462^x))

bluefishmodelplot=Plot[5.3 * E^(0.3797 x), {x, 0,11}]

Show[bluefishplot,bluefishmodelplot]

bluecrabs={10,85,133,250,300,370,440,466,480,442,500};
bluecrabsdata=Transpose[{timeperiod,bluecrabs}];
bluecrabsplot=ListPlot[bluecrabsdata]

transbluecrabsdata=Transpose[{Sqrt[timeperiod],bluecrabs}];
transbluecrabsplot=ListPlot[transbluecrabsdata]

Fit[transbluecrabsdata,{u},u]

y = 158.344 (x^0.5)

bluecrabsmodelplot=Plot[158.344 Sqrt[x], {x, 0,11}]

Show[bluecrabsplot,bluecrabsmodelplot]

At the year 2010 (timeperoid=14), blue fish  y =  5.3 (e^(0.3797(14))) =1078.69 (10,000 lb) and 
blue crabs y = 158.344 ((14^0.5)) = 592.469 (10,000 lb).

The amount of blue fish may be larger than one might predict, whereas the result for the blue crabs may be a little lower than one might expect.

These simple models should be used for interpolation and not extrapolation!

Interpolating Polynomials

We want to find a quadratic function that contains the points (-1, 2), (0, 3) and (2, -1).

InterpolatingPolynomial[{{-1,2},{0,3},{2,-1}},x]

Expand[%]

Expand[InterpolatingPolynomial[{{-1,2},{0,3},{1,0},{2,-1}},x]]

g1=ListPlot[{{-1,2},{0,3},{1,0},{2,-1}},PlotStyle->{PointSize[0.02]}];
g2=Plot[3-2 x-2 (x^2)+(x^3),{x,-3,3}];
Show[g2,g1]

data={{-5,-1.},{-4,1},{-3,-1},{-2,1},{-1,-1},{0,1},{1,-1},{2,1},{3,-1},{4,1},{5,-1}};
g1=ListPlot[data,PlotStyle->{PointSize[0.02]},PlotRange->{{-6,6},{-1.5,1.5}}]

y=Expand[InterpolatingPolynomial[data,x]]

As seen below this 10th degree polynomial is not a good fit to the data.

g1=ListPlot[data,PlotStyle->{PointSize[0.02]}];
g2=Plot[y,{x,-3.5,3.5}];
g3=Plot[y,{x,-4.5,4.5}];
g4=Plot[y,{x,-6,6}];
Show[g2,g1]
Show[g3,g1]
Show[g4,g1]

Below the polynomial is increasing on the right side, while we may be expecting the data to continue to be decreasing!

y=Expand[InterpolatingPolynomial[{{-1,2},{0,3},{1,0},{2,-1}},x]];g1=ListPlot[{{-1,2},{0,3},{1,0},{2,-1}},PlotStyle->{PointSize[0.02]}];
g2=Plot[y,{x,-3,3}];
Show[g2,g1]

Spline Command

We need the spline package. It is inputted as shown below. However, if you have used the command Spline before calling the package, it will not work. Either remove its usage from the memory using Remove[Spline] or close and restart Mathematica. Mathematica can show you the spline graphically. If you want the equations, you have to do it on your own!

Needs["Splines`"]

Graphics[{Spline[{{0,0},{1,0},{2,2},{0,1}}, Cubic],
Point[{{0,0},{1,0},{2,2},{0,1}}]}]

pts={{1,5},{2,8},{3,25}};
Graphics[{Spline[pts, Cubic],
{ PointSize[Medium], Blue,Point[pts]}}]

pts={{1,5},{2,8},{3,25}};
g1=ListPlot[pts,PlotStyle->PointSize[0.02]];
g2=Graphics[Spline[pts, Cubic]];
Show[g1,g2]

pts={{1,5},{2,8},{3,25}};
Graphics[Spline[pts, Cubic,
 SplineDots->Automatic]]

Graphics[Spline[pts, Cubic, SplineDots->Directive[Red, PointSize[Medium]]]]

A Simple Way to Find Splines

(* Just type in the equations and solve the system! *)
(* For the data (1,5),(2,8),(3,25), and cubics S[1](x) = a[1] + b[1] x + c[1] (x^2) + d[1] (x^3) and S[2](x) = a[2] + b[2] x + c[2] (x^2) + d[2] (x^3) the equations are

a[1]+b[1]+c[1]+d[1]==5,
a[2]+2 b[2]+4 c[2]+8 d[2]==8,
a[1]+2 b[1]+4 c[1]+8 d[1]==8,
a[2]+3 b[2]+9 c[2]+27 d[2]==25,
b[1]+4 c[1]+12 d[1]==b[2]+4 c[2]+12 d[2],
2 c[1]+12 d[1]==2 c[2]+12 d[2],
2 c[1]+6 d[1]==0 and
2 c[2]+18 d[2]==0.

It is easier to use [1] or [2] rather than subscript 1 or 2, respectively!

To solve them, do the following. If you want decimal values, use NSolve command in place of Solve command. *)

ClearAll[data, a,b,c,d, S]
Solve[{a[1]+b[1]+c[1]+d[1]==5,a[2]+2 b[2]+4 c[2]+8 d[2]==8,a[1]+2 b[1]+4 c[1]+8 d[1]==8,a[2]+3 b[2]+9 c[2]+27 d[2]==25,b[1]+4 c[1]+12 d[1]==b[2]+4 c[2]+12 d[2],2 c[1]+12 d[1]==2 c[2]+12 d[2],2 c[1]+6 d[1]==0,2 c[2]+18 d[2]==0}]

(* If you want answers in the order a, b, c and d, for the first and then second cubic, do the following.*)
Solve[{a[1]+b[1]+c[1]+d[1]==5,a[2]+2 b[2]+4 c[2]+8 d[2]==8,a[1]+2 b[1]+4 c[1]+8 d[1]==8,a[2]+3 b[2]+9 c[2]+27 d[2]==25,b[1]+4 c[1]+12 d[1]==b[2]+4 c[2]+12 d[2],2 c[1]+12 d[1]==2 c[2]+12 d[2],2 c[1]+6 d[1]==0,2 c[2]+18 d[2]==0},{a[1],b[1],c[1], d[1], a[2], b[2], c[2], d[2]}]

(* Now define each cubic, graph them, along with the data and show all of the together. *)
S[1][x_]:= 2+ 10 x-21/2 x^2 + 7/2 x^3;
S[2][x_]:=58  -74 x  +63/2 x^2 -7/2 x^3;
data={{1,5},{2,8},{3,25}};
s1plot=Plot[S[1][x],{x, 1,2},PlotStyle->Red];
s2plot=Plot[S[2][x], {x,2, 3},PlotStyle->Blue];
dataplot=ListPlot[data,PlotStyle->Black];
Show[dataplot, s1plot, s2plot]

Comparing an Empirical Model and a Qualitative Model

speed={20,25,30,35,40,45,50,55,60,65,70,75,80};
reactiondistance={22,28,33,39,44,50,55,61,66,72,77,83,88};
brakingdistance={20,28,40.5,52.5,72,92.5,118,148.5,182,220.5,266,318,376};
stoppingdistance=reactiondistance+brakingdistance;
reactiondata=Transpose[{speed,reactiondistance}];
brakingdata=Transpose[{speed,brakingdistance}];
stoppingdata=Transpose[{speed,stoppingdistance}];

Graphically, the book came up with the model d = 1.1 v + 0.054 (v^2), with modeling reaction distance and braking distance separately.

Using the least-squares regression, we get the model  d = 1.104 v + 0.0542 (v^2),  with modeling reaction distance and braking distance separately, as shown below.

Fit[reactiondata,{v},{v}]
Fit[brakingdata,{v^2},{v}]

Notice that this model is not the same if we modeled without uisng  reaction distance and braking distance submodels.

Fit[stoppingdata,{v,v^2},{v}]

g1=Plot[1.104v+0.0542v^2,{v,10,85},PlotStyle->{Red}];
g2=Graphics[Spline[stoppingdata, Cubic,SplineDots->Directive[Blue, PointSize[Medium]]]];
Show[g1,g2]

An Automated Way of Finding The Cubic Spline - A Simple 
Problem

(* Input the data. We could do each coordinate separately and combine as before using Transpose command. *)

ClearAll[data, a,b,c,d,x,y,S, Sp, eqns,splot]

data={{1,5},{2,8},{3,25}};

(* This is the plot of data that will be recalled at the end. *)

dataplot=ListPlot[data,PlotStyle->Black];

(* We use index i to defined the spline over the interval i. *)

(* Each spline S[i][x] will be defined from ith x value x[i] to (i+1)st x value x[i+1]. *)

S[i_][x_]=a[i]+b[i]*x+c[i]*(x^2)+d[i]*(x^3);



(* Each x[i] is the first coordinate if the ith data point data[[i, 1]], while each y[i] is the second coordinate if the ith data point data[[i, 2]]. Do looops allow us the do this naming in an efficient way. *)

Do[x[i_]:=data[[i,1]], {i,1, Length[data]}]
Do[y[i_]:=data[[i,2]], {i,1,Length[data]}]

(* We will write the set of equation in stages and add each set to the last by the command Append. *)

(* The value of each cubic at its left endpoint S[i][x[i]] is equal to the corresponding y value of data y[i]. There are n-1 left endpoints numbered as i's, from i=1 to i= Length[data]-1. This gives n-1 equations. *)

eqns=Table[S[i][x[i]]==y[i],{i,1,Length[data]-1}];

(* The value of each cubic at its right endpoint S[i][x[i+1]] is equal to the corresponding y value of data y[i+1]. There are n-1 right endpoints numbered as (i+1)'s, from i=1 to i=Length[data]-1. This gives another n-1 equations.*)

Do[AppendTo[eqns, S[i][x[i+1]]==y[i+1]], {i,1,Length[data]-1}]


(* Set first derivatives equal to each other at interior points (maintain slope). *)

(* The value of the derivative of each cubic at its right endpoint S[i]'[x[i+1]] should match the value of the derivative of the next cubic at its left endpoint S[i+1]'[x[i+1]]]. The last two cubics this is true for are (n-1)st and nth ones. For S[i+1]=s[n], i must be n-2. So, these equations are for i=1 to i=Length[data]-2. *)

Do[AppendTo[eqns, S[i]'[x[i+1]]==S[i+1]'[x[i+1]]],{i,1,Length[data]-2}]

(* Set second derivatives equal to each other at interior points (maintain concavity). *)

(* The value of the second derivative of each cubic at its right endpoint S[i]''[x[i+1]] should match the value of the second derivative of the next cubic at its left endpoint S[i+1]''[x[i+1]]]. The last two cubics this is true for are (n-1)st and nth ones. For S[i+1]=s[n], i must be n-2. So, these equations are for i=1 to i=Length[data]-2.*)

Do[AppendTo[eqns, S[i]''[x[i+1]]==S[i+1]''[x[i+1]]],{i,1,Length[data]-2}]

(* Account for endpoints,either by setting second derivatives equal to 0 (natural spline) or by setting first derivatives equal to what they are known to be (clamped spline). *)

(* This iss for the leftmost endpoint. *)

AppendTo[eqns, S[1]''[x[1]]==0];

(* This iss for the rightmost endpoint. *)

AppendTo[eqns, S[Length[data]-1]''[x[Length[data]]]==0];

(* Now, we can see the list of our equations. *)

eqns

(* Below, we solve the equations. To get decimal values, use NSolve in place of Solve. *)

coeffs=Solve[eqns];

(* To input the constants into cubics, we define Sp[i][x] to be the ith cubic but with coefficients replaced by the coefficient we found, /. coeffs. At the same tome, to see the cubics, we ask Mathematica to print them. A do loop does this efficiently.*)

Do[Sp[i][x_]=S[i][x]/.coeffs;
Print[Sp[i][x]],{i,1, Length[data]-1}]

{2+10 x-((21 (x^2))/2)+((7 (x^3))/2)}
{58-74 x+((63 (x^2))/2)-((7 (x^3))/2)}

(* Now, we graph each cubic on its iterval. splot[i] is the plot of sp[i] from x[i] to x[i+1]. A do loop does this efficiently. *)

(* I changed the independent variable of the splines Sp to z since Mathematica had difficulty distiguishing between the independent variable x and the x coordinates of data points x[i]*)

Do[splot[i]=Plot[Sp[i][z], {z,x[i], x[i+1]},PlotStyle->Hue[i/(Length[data]-1)]],{i,1,Length[data]-1}]

(* Now, we show the data and the cubic spline together. *)

Show[dataplot,Table[splot[i], {i,1, Length[data]-1}]]

An Automated Way of Finding The Cubic Spline - The Braking Distance Problem

(* Input the data. We could do each coordinate separately and combine as before using Transpose command. *)

ClearAll[data, a,b,c,d,x,y,S, Sp, eqns,splot]

speed={20,25,30,35,40,45,50,55,60,65,70,75,80};
reactiondistance={22,28,33,39,44,50,55,61,66,72,77,83,88};
brakingdistance={20,28,40.5,52.5,72,92.5,118,148.5,182,220.5,266,318,376};
stoppingdistance=reactiondistance+brakingdistance;
data=Transpose[{speed,stoppingdistance}];

(* This is the plot of data that will be recalled at the end. *)

dataplot=ListPlot[data,PlotStyle->Black];

(* We use index i to defined the spline over the interval i. *)

(* Each spline S[i][x] will be defined from ith x value x[i] to (i+1)st x value x[i+1]. *)

S[i_][x_]=a[i]+b[i]*x+c[i]*(x^2)+d[i]*(x^3);


(* Each x[i] is the first coordinate if the ith data point data[[i, 1]], while each y[i] is the second coordinate if the ith data point data[[i, 2]]. Do looops allow us the do this naming in an efficient way. *)

Do[x[i_]:=data[[i,1]], {i,1, Length[data]}]
Do[y[i_]:=data[[i,2]], {i,1,Length[data]}]


(* We will write the set of equation in stages and keep each set to the alst by the command Append. *)

(* The value of each cubic at its left endpoint S[i][x[i]] is equal to the corresponding y value of data y[i]. There are n-1 left endpoints numbered as i's, from i=1 to i= Length[data]-1. This gives n-1 equations. *)

eqns=Table[S[i][x[i]]==y[i],{i,1,Length[data]-1}];

(* The value of each cubic at its right endpoint S[i][x[i+1]] is equal to the corresponding y value of data y[i+1]. There are n-1 right endpoints numbered as (i+1)'s, from i=1 to i=Length[data]-1. This gives another n-1 equations.*)

Do[AppendTo[eqns, S[i][x[i+1]]==y[i+1]], {i,1,Length[data]-1}]

(* Set first derivatives equal to each other at interior points (maintain slope). *)

(* The value of the derivative of each cubic at its right endpoint S[i]'[x[i+1]] should match the value of the derivative of the next cubic at its left endpoint S[i+1]'[x[i+1]]]. The last two cubics this is true for are (n-1)st and nth ones. For S[i+1]=s[n], i must be n-2. So, these equations are for i=1 to i=Length[data]-2. *)

Do[AppendTo[eqns, S[i]'[x[i+1]]==S[i+1]'[x[i+1]]],{i,1,Length[data]-2}]

(* Set second derivatives equal to each other at interior points (maintain concavity). *)

(* The value of the second derivative of each cubic at its right endpoint S[i]''[x[i+1]] should match the value of the second derivative of the next cubic at its left endpoint S[i+1]''[x[i+1]]]. The last two cubics this is true for are (n-1)st and nth ones. For S[i+1]=s[n], i must be n-2. So, these equations are for i=1 to i=Length[data]-2.*)

Do[AppendTo[eqns, S[i]''[x[i+1]]==S[i+1]''[x[i+1]]],{i,1,Length[data]-2}]

(* Account for endpoints,either by setting second derivatives equal to 0 (natural spline) or by setting first derivatives equal to what they are known to be (clamped spline). *)

(* This iss for the leftmost endpoint. *)

AppendTo[eqns, S[1]''[x[1]]==0];

(* This iss for the rightmost endpoint. *)

AppendTo[eqns, S[Length[data]-1]''[x[Length[data]]]==0];


(* Now, we can see the list of our equations. *)

eqns

{a[1]+20 b[1]+400 c[1]+8000 d[1]==42,a[2]+25 b[2]+625 c[2]+15625 d[2]==56,a[3]+30 b[3]+900 c[3]+27000 d[3]==73.5`,a[4]+35 b[4]+1225 c[4]+42875 d[4]==91.5`,a[5]+40 b[5]+1600 c[5]+64000 d[5]==116,a[6]+45 b[6]+2025 c[6]+91125 d[6]==142.5`,a[7]+50 b[7]+2500 c[7]+125000 d[7]==173,a[8]+55 b[8]+3025 c[8]+166375 d[8]==209.5`,a[9]+60 b[9]+3600 c[9]+216000 d[9]==248,a[10]+65 b[10]+4225 c[10]+274625 d[10]==292.5`,a[11]+70 b[11]+4900 c[11]+343000 d[11]==343,a[12]+75 b[12]+5625 c[12]+421875 d[12]==401,a[1]+25 b[1]+625 c[1]+15625 d[1]==56,a[2]+30 b[2]+900 c[2]+27000 d[2]==73.5`,a[3]+35 b[3]+1225 c[3]+42875 d[3]==91.5`,a[4]+40 b[4]+1600 c[4]+64000 d[4]==116,a[5]+45 b[5]+2025 c[5]+91125 d[5]==142.5`,a[6]+50 b[6]+2500 c[6]+125000 d[6]==173,a[7]+55 b[7]+3025 c[7]+166375 d[7]==209.5`,a[8]+60 b[8]+3600 c[8]+216000 d[8]==248,a[9]+65 b[9]+4225 c[9]+274625 d[9]==292.5`,a[10]+70 b[10]+4900 c[10]+343000 d[10]==343,a[11]+75 b[11]+5625 c[11]+421875 d[11]==401,a[12]+80 b[12]+6400 c[12]+512000 d[12]==464,b[1]+50 c[1]+1875 d[1]==b[2]+50 c[2]+1875 d[2],b[2]+60 c[2]+2700 d[2]==b[3]+60 c[3]+2700 d[3],b[3]+70 c[3]+3675 d[3]==b[4]+70 c[4]+3675 d[4],b[4]+80 c[4]+4800 d[4]==b[5]+80 c[5]+4800 d[5],b[5]+90 c[5]+6075 d[5]==b[6]+90 c[6]+6075 d[6],b[6]+100 c[6]+7500 d[6]==b[7]+100 c[7]+7500 d[7],b[7]+110 c[7]+9075 d[7]==b[8]+110 c[8]+9075 d[8],b[8]+120 c[8]+10800 d[8]==b[9]+120 c[9]+10800 d[9],b[9]+130 c[9]+12675 d[9]==b[10]+130 c[10]+12675 d[10],b[10]+140 c[10]+14700 d[10]==b[11]+140 c[11]+14700 d[11],b[11]+150 c[11]+16875 d[11]==b[12]+150 c[12]+16875 d[12],2 c[1]+150 d[1]==2 c[2]+150 d[2],2 c[2]+180 d[2]==2 c[3]+180 d[3],2 c[3]+210 d[3]==2 c[4]+210 d[4],2 c[4]+240 d[4]==2 c[5]+240 d[5],2 c[5]+270 d[5]==2 c[6]+270 d[6],2 c[6]+300 d[6]==2 c[7]+300 d[7],2 c[7]+330 d[7]==2 c[8]+330 d[8],2 c[8]+360 d[8]==2 c[9]+360 d[9],2 c[9]+390 d[9]==2 c[10]+390 d[10],2 c[10]+420 d[10]==2 c[11]+420 d[11],2 c[11]+450 d[11]==2 c[12]+450 d[12],2 c[1]+120 d[1]==0,2 c[12]+480 d[12]==0}


(* Below, we solve the equations. To get decimal values, use NSolve in place of Solve. *)

coeffs=Solve[eqns];

(* To inpout the constants into cubics, we define Sp[i][x] to be the ith cubic but with coefficients replaced by the coefficient we found, /. coeffs. At the same tome, to see the cubics, we ask Mathematica to print them. A do loop does this efficiently.*)

Do[Sp[i][x_]=S[i][x]/.coeffs;
Print[Sp[i][x]],{i,1, Length[data]-1}]

(* Now, we graph each cubic on its iterval. splot[i] is the plot of sp[i] from x[i] to x[i+1]. A do loop does this efficiently. *)

(* I changed the independent variable of the splines Sp to z since Mathematica had difficulty distiguishing between the independent variable x and the x coordinates of data points x[i]*)

Do[splot[i]=Plot[Sp[i][z], {z,x[i], x[i+1]},PlotStyle->Hue[i/(Length[data]-1)]],{i,1,Length[data]-1}]

(* Now, we show the data and the cubic spline together. *)

Show[dataplot,Table[splot[i], {i,1, Length[data]-1}]]

The Automated Cubic Spline Code (with no explanation)

ClearAll[data, a,b,c,d,x,y,S, Sp, eqns,splot]
speed={20,25,30,35,40,45,50,55,60,65,70,75,80};
reactiondistance={22,28,33,39,44,50,55,61,66,72,77,83,88};
brakingdistance={20,28,40.5,52.5,72,92.5,118,148.5,182,220.5,266,318,376};
stoppingdistance=reactiondistance+brakingdistance;
data=Transpose[{speed,stoppingdistance}];
dataplot=ListPlot[data,PlotStyle->Black];
S[i_][x_]=a[i]+b[i]*x+c[i]*(x^2)+d[i]*(x^3);
Do[x[i_]:=data[[i,1]], {i,1, Length[data]}]
Do[y[i_]:=data[[i,2]], {i,1,Length[data]}]
eqns=Table[S[i][x[i]]==y[i],{i,1,Length[data]-1}];
Do[AppendTo[eqns, S[i][x[i+1]]==y[i+1]], {i,1,Length[data]-1}]
Do[AppendTo[eqns, S[i]'[x[i+1]]==S[i+1]'[x[i+1]]],{i,1,Length[data]-2}]
Do[AppendTo[eqns, S[i]''[x[i+1]]==S[i+1]''[x[i+1]]],{i,1,Length[data]-2}]
AppendTo[eqns, S[1]''[x[1]]==0];
AppendTo[eqns, S[Length[data]-1]''[x[Length[data]]]==0];
coeffs=Solve[eqns];
Do[Sp[i][x_]=S[i][x]/.coeffs;
Print[Sp[i][x]],{i,1, Length[data]-1}]
Do[splot[i]=Plot[Sp[i][z], {z,x[i], x[i+1]},PlotStyle->Hue[i/(Length[data]-1)]],{i,1,Length[data]-1}]
Show[dataplot,Table[splot[i], {i,1, Length[data]-1}]]

A Example to Demonstrate Matching of Splines at Their Endpoints

ClearAll[data, a,b,c,d,x,y,S, Sp, eqns,splot]
data={{7,8},{14,41},{21,133},{28,250}, {35,280},{42, 297}};
dataplot=ListPlot[data,PlotStyle->Black];
S[i_][x_]=a[i]+b[i]*x+c[i]*(x^2)+d[i]*(x^3);
Do[x[i_]:=data[[i,1]], {i,1, Length[data]}]
Do[y[i_]:=data[[i,2]], {i,1,Length[data]}]
eqns=Table[S[i][x[i]]==y[i],{i,1,Length[data]-1}];
Do[AppendTo[eqns, S[i][x[i+1]]==y[i+1]], {i,1,Length[data]-1}]
Do[AppendTo[eqns, S[i]'[x[i+1]]==S[i+1]'[x[i+1]]],{i,1,Length[data]-2}]
Do[AppendTo[eqns, S[i]''[x[i+1]]==S[i+1]''[x[i+1]]],{i,1,Length[data]-2}]
AppendTo[eqns, S[1]''[x[1]]==0];
AppendTo[eqns, S[Length[data]-1]''[x[Length[data]]]==0];
eqns;
coeffs=Solve[eqns];
Do[Sp[i][x_]=S[i][x]/.coeffs;
Print[Sp[i][x]],{i,1, Length[data]-1}]
Do[splot[i]=Plot[Sp[i][z], {z,x[i]-2(x[i+1]-x[i]), x[i+1]+2(x[i+1]-x[i])},PlotStyle->Hue[i/(Length[data]-1)]],{i,1,Length[data]-1}]
Show[dataplot,Table[splot[i], {i,1, Length[data]-1}]]